home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TSR
/
STAY50
/
SR50.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-11-28
|
68KB
|
1,440 lines
{$I direct.inc}
{──────────────────────────────────────────────────────────────────────}
{ Turbo Pascal Stay Resident Shell Interrupt Service Routines }
{ }
{ Copyright (c) 1988 Lane H. Ferris }
{──────────────────────────────────────────────────────────────────────}
unit SR50 ;
{──────────────────────────────────────────────────────────────────────}
interface
{──────────────────────────────────────────────────────────────────────}
type
bool = boolean ;
string8 = string[8] ;
RUTidblktype = record { aRe yoU There id block }
RUTidstr : string[9] ; { string identifier }
RUTtermbyte : boolean ; { quit this pgm byte }
end {RUTblktype} ;
const
debug : boolean = false ; { show interesting addrs }
RUTidblk : RUTidblktype =
(RUTidstr:'SR 5.00 '; RUTTermbyte:false ) ;
DftWindow : array[1..4] of { default window coordinates }
byte = (1,1,80,25) ;
Reserve = 1 ; { Reserve/Release a resource }
Rlse = 2 ;
_CRT = 1 ; { Resource id s }
_KBD = 2 ;
border = true ; { border or not for makewindow }
noborder = false ;
type
stackframe = record { picture of a stack frame }
Bp,ES,DS,Di,Si,Dx,Cx,Bx,Ax,Ip,CS,flags :word ;
end {stackframe} ;
stackptr = ^stackframe ; { points to a stack frame }
SRBptr = ^SRBlock ;
SRBlock = record { Stay Resident Block }
SRBstackptr:stackptr ; { Stack pointer offset }
SRBlink :SRBptr ; { Chain to next block }
Procid :word ; { Thread id number }
Procptr :pointer ; { pointer to procedure }
POPproc :pointer ; { pointer to popupdn routine }
PSP :word ; { segment Prefix storage area }
DTA :pointer ; { pointer disk transfer area }
INT22ptr :pointer ; { tasks terminate vector }
INT23ptr :pointer ; { tasks CtrlBreak vector }
INT24ptr :pointer ; { tasks Critical error vector }
INT1Bptr :pointer ; { tasks CtrlBreak 1B vector }
CursorType : word ; { Cursor scan lines from bios }
CursorX : byte ; { Cursor position X,Y }
CursorY : byte ;
SRBVideoPage : byte ; { Active Video Page }
{ Extended error registers }
ExtErrInfo : array[1..8] of word;
CtrlCstatus : byte ; { Control-C on or off }
VerifyStatus : byte ; { Disk Verify status on/off }
SRBname : String[8] ; { Character name of Thread }
SRBsuspended : word ; { Non-Dispatchability bits }
SRBtype : word ; { Task Type, timer,hotkey etc }
KeyValue : word ; { HotKey or timer value }
END {SRB record} ;
const {for SRBsuspended word } { Dispatchabe status }
Suspended = 0001 ; { SRB is suspended }
TimerWait = 0002 ; { SRB is doing a Delay }
DosOwned = 0004 ; { DOS is owned by one task }
MsgWait = 0008 ; { Waiting receieve in mailbox }
var
CurrentSRB : SRBptr ; { Ptr to Current Active SRB }
Videoseg : word ; { Upper Left of scrn }
const {for SRBtype }
TimerType = 0001 ; { Task activates on timer }
KeyType = 0002 ; { Task activates on hotkey }
Systype = 0004 ; { Task is an internal task }
TimerTicks : word = 0 ; { Interrupt 8 ticks }
Procedure Attach( pUserPgmPtr:pointer; TsrType:word;
TsrValue:word ; pPopproc:pointer ; pName:string8) ;
Procedure Freeze ;
Procedure UnFreeze ;
Function GetSRBaddr : pointer ;
Function GetSRBid : word ;
Procedure StartTSR ;
Procedure Resource (operation,resourceid : integer ) ;
Procedure Suspend (pSRBid : word ; pSuspendbits : word ) ;
Procedure UnSuspend(pSRBid : word ; pSuspendbits : word ) ;
Procedure Yield ;
Procedure SingleTask ;
Procedure MultiTask ;
Procedure SR50_Xit ;
{──────────────────────────────────────────────────────────────────────}
implementation
{──────────────────────────────────────────────────────────────────────}
uses crt ,
dos ,
macros,
SR50subs,
SRmsgu ;
const
BIOSI8 = 8; { Bios Timer interrupt }
BIOSI16 = $16; { Bios Keyboard interrupt }
BIOSI13 = $13; { Bios Disk interrupt }
DOSI1B = $1B; { Bios Ctrl-Break intr id }
DOSI21 = $21; { DOS service router interrupt }
DOSI22 = $22; { DOS terminate address }
DOSI23 = $23; { DOS Ctrl-C interrupt id }
DOSI24 = $24; { DOS critical interrupt id }
DOSI28 = $28; { DOS Idle interrupt id }
DosIdle :boolean = false ; { Dos is idle in INT 28 }
DosIdleDelay :integer = 10 ; { 10 milsec delay in INT 28 }
NumActiveSRBs:integer = 0 ; { number of active tasks }
{ character Rotor on screen to show dispatching }
Rotreller : array[0..3] of byte = ($11,$1E,$10,$1f) ;
Rotrposition : byte = 0 ; { Rotreller position }
PutRotr : pointer = nil ; { Upper right of scrn ptr }
stacksize : integer = 1024 ; { stack size for each task }
stackOverhead : integer = $200 ; { size of Turbo overhead }
const
zflag = $40 ; { zero flag in 8086 flags }
Status : byte = 0 ; { Status of current TSR activity }
Inuse = 02 ; { TSR single process is active }
frozen = 04 ; { Someone froze the system }
Hotkeyon : boolean = false ; { Received the HotKey }
Ints_Busy : byte = 0 ; { Active interrupts flags }
INT13on = 04 ; { Disk interrupt is active }
INT16on = 02 ; { Int16 critical code busy }
Foxs = $FF ;
Int8Busy : boolean = false ; { Semaphor in interrupt 8 }
Int8Waiting : word = 0 ; { Int 8 missed dispatch count }
Tick_request : word = 19 ; { activate user on count }
DosIdleCount : word = 0 ; { Dos Idle routine semaphore }
{ byte in seg $50 }
Resources : array[_CRT.._KBD] of byte = (0,1) ;
Var
VideoCols : byte absolute $40:$4A ; { number of bios video columes }
VideoRows : byte absolute $40:$84 ; { number of bios video rows }
VideoPage : byte absolute $40:$62 ; { active video page }
VideoX : byte absolute $40:$50 ; { cursor location x page 1 }
VideoY : byte absolute $40:$51 ; { cursor location y page 1 }
BiosCursor : word absolute $40:$60 ; { BIOS end/start cursor lines }
BiosCurPos : word absolute $40:$50 ; { BIOS cursor position page 1 }
Var
{ Int5 PrintScreen status byte }
PrintScreenStatus : byte absolute $50:0 ;
DosIdleSRB : SRBptr ; { Ptr to INDOS ISR SRB }
TimerSRB : SRBptr ; { Ptr to Timer ISR SRB }
DosStackPtr : pointer ; { location of InDos stack }
Int16stack : pointer ; { forground int16 stack save }
InTimerStackptr :pointer ; { temporary ptr to stack }
BIOS_INT8 : pointer ; { BIOS Timer Interrupt Vector }
BIOS_INT16 : pointer ; { BIOS Keyboard Interrupt Vector }
BIOS_INT13 : pointer ; { BIOS Disk Interrupt Vector }
DOS_INT28 : pointer ; { DOS idle Service interrupt Vector }
Exit_Vec : pointer ; { pointer to previous Exit Procedure }
{─────────────────JumptoInterrupt ──────────────────────}
Procedure JumpToInterrupt( oldvector : pointer );
inline( { Jump to old Intr from local ISR }
$5B/ { POP BX IP part of vector }
$58/ { POP AX CS part of vector }
$87/$5E/$0E/ { XCHG BX,[BP+14] switch ofs/bx }
$87/$46/$10/ { XCHG AX,[BP+16] switch seg/ax }
$8B/$E5/ { MOV SP,BP }
$5D/ { POP BP }
$07/ { POP ES }
$1F/ { POP DS }
$5F/ { POP DI }
$5E/ { POP SI }
$5A/ { POP DX }
$59/ { POP CX }
$CB { RETF Jump [ToOldVector] }
) ; { to original timer vector }
{end JumpToInterrupt}
{─────────────────CallInterrupt─────────────────────}
Procedure CallInterrupt( oldvector : pointer ) ; { stack image }
inline($55/ { PUSH BP } { ip \ return }
$89/$E5/ { MOV BP,SP } { cs to here }
$9C/ { PUSHF create an IRET return} { flags/ }
$36/ { SS: } { bp <--sp }
$FF/$5E/$02/ { CALLfar [BP+02] } { cs \ }
$5D/ { POP BP } { ip /old vector }
$83/$C4/$04 ); { ADD SP,+04 } { }
{end CallInterrupt}
{──────────────── Return to New SRB ─────────────────}
Procedure ReturnToNewTask ; { restore a stack frame }
inline(
$C4/$1E/CurrentSRB/ { LES BX,[CurrentSRB] }
$26/$C4/$5F/$00/ { LES BX,ES:[BX+stackptr]}
$8C/$C0/ { MOV AX,ES }
$8E/$D0/ { MOV SS,AX }
$89/$DC/ { MOV SP,BX }
$89/$E5); { MOV BP,SP }
{ Turbo does: MOV SP,BP }
{END ReturnToNewTask} { POP BP etc }
Procedure Switch_to_Timer_stack ;
inline( { switch to safe stack }
$C4/$1E/TimerSRB/ { LES BX,[TimerSRB] }
$26/$C4/$5F/$00/ { LES BX,ES:[BX+stackptr]}
$8C/$C0/ { MOV AX,ES }
$8E/$D0/ { MOV SS,AX }
$89/$DC/ { MOV SP,BX }
$89/$E5 ); { MOV BP,SP }
{END Switch_to_Timer_Stack}
{─────────────── Exit _ Timer ──────────}
Procedure Exit_Timer ; { restore regs and exit this routine }
BEGIN
DisableInterrupts ;
int8busy := false ; { reset code busy condition }
inline(
$C4/$1E/InTimerStackptr/ { LES BX,[InStackptr] }
$8C/$C0/ { MOV AX,ES }
$8E/$D0/ { MOV SS,AX }
$89/$DC/ { MOV SP,BX }
$89/$E5/ { MOV BP,SP }
$5D/ { POP BP }
$07/ { POP ES }
$1F/ { POP DS }
$5F/ { POP DI }
$5E/ { POP SI }
$5A/ { POP DX }
$59/ { POP CX }
$5B/ { POP BX }
$58/ { POP AX }
$CF { IRET }
) ;
END {Exit_Timer} ;
Procedure SaveStackFrame ;
inline( { save full stack frame }
$5D/ { pop bp local bp }
$58/ { pop ax fetch ip }
$5B/ { pop bx fetch cs }
$9C/ { pushf }
$53/ { push bx set CS }
$50/ { push ax set ip }
$50/ { push ax }
$53/ { push bx }
$51/ { push cx }
$52/ { push dx }
$56/ { push si }
$57/ { push di }
$1E/ { push ds }
$06/ { push es }
$55/ { push bp }
$89/$E5 { mov bp,sp }
);
{END SaveStackFrame}
Procedure RestoreStackFrame ;
inline( { restore full stackframe }
$89/$EC/ { mov sp,bp }
$5D/ { pop bp }
$07/ { pop es }
$1F/ { pop ds }
$5F/ { pop di }
$5E/ { pop si }
$5A/ { pop dx }
$59/ { pop cx }
$5B/ { pop bx }
$58/ { pop ax }
$CF { IRET }
) ;
{END RestoreStackFrame}
{────────────────────────────────────────────────────────────────────}
{ Freeze/UnFreeze }
{────────────────────────────────────────────────────────────────────}
{ This procedure primarily used for debugging }
{────────────────────────────────────────────────────────────────────}
Procedure Freeze ;
BEGIN
Status := status or frozen ; { Freeze the INT8 dispatcher }
END {Freeze} ;
Procedure UnFreeze ;
BEGIN
Status := status and (NOT frozen) ; { start the INT8 dispatcher }
END {UnFreeze} ;
{────────────────────────────────────────────────────────────────────}
{ SingleTask/MultiTask }
{────────────────────────────────────────────────────────────────────}
Procedure SingleTask ;
BEGIN
Status := status or inuse ; { SingleTask the INT8 dispatcher }
END {SingleTask} ;
Procedure MultiTask ;
BEGIN
Status := status and (NOT inuse) ; { start the INT8 dispatcher }
END {MultiTask} ;
{────────────────────────────────────────────────────────────────────}
{ GetSRBaddr }
{────────────────────────────────────────────────────────────────────}
{ Return the address of the Current StayResidentBlock }
{────────────────────────────────────────────────────────────────────}
Function GetSRBaddr : pointer ;
BEGIN
GetSRBaddr := CurrentSRB ; { give caller current SRB address}
END {GetSRB} ;
{────────────────────────────────────────────────────────────────────}
{ GetSRBid }
{────────────────────────────────────────────────────────────────────}
{ Return the Procedure id of the current StayResidentblock }
{────────────────────────────────────────────────────────────────────}
Function GetSRBid : word ;
BEGIN
GetSRBid := CurrentSRB^.procid ; { give caller current SRB id }
END {GetSRB} ;
{────────────────────────────────────────────────────────────────────}
{ FindSRB }
{────────────────────────────────────────────────────────────────────}
{ Find the SRB pointer matching the SRB id }
{────────────────────────────────────────────────────────────────────}
Function FindSRB(ftSRBid : word ) : SRBptr ;
var
TestSRB : SRBptr ;
i : integer ;
begin
TestSRB := CurrentSRB ; { set first SRB ptr }
for i := 1 to numActiveSRBs do
if TestSRB^.procid = ftSRBid then { search for SRB id }
begin
FindSRB := TestSRB ; { return SRB addr ..}
exit ;
end {if TestSRB..}
else
TestSRB := TestSRB^.SRBlink ;
end {FindSRB} ;
{─────────────────────────────────────────────────────────────────────}
{ Suspend }
{─────────────────────────────────────────────────────────────────────}
{ Suspend a Procedure id with Suspend bits }
{─────────────────────────────────────────────────────────────────────}
Procedure Suspend(pSRBid : word ; pSuspendbits : word ) ;
var
sSRBaddr : SRBptr ;
Begin
sSRBaddr := FindSRB(pSRBid) ;
sSRBaddr^.SRBsuspended := sSRBaddr^.SRBsuspended
or pSuspendbits ;
End { Suspend } ;
{─────────────────────────────────────────────────────────────────────}
{ Unsuspend }
{─────────────────────────────────────────────────────────────────────}
{ Clear suspend bits in a StayResidentBlock }
{─────────────────────────────────────────────────────────────────────}
Procedure Unsuspend(pSRBid : word ; psuspendbits : word ) ;
var
sSRBaddr : SRBptr ;
Begin
sSRBaddr := FindSRB(pSRBid) ;
sSRBaddr^.SRBsuspended := sSRBaddr^.SRBsuspended
and (NOT pSuspendbits) ;
End { Unsuspend } ;
{─────────────────────────────────────────────────────────────────────}
{ DosCallsAllowed }
{─────────────────────────────────────────────────────────────────────}
{ Return true if Dos is in a state to accept function calls }
{─────────────────────────────────────────────────────────────────────}
Function DosCallsAllowed : boolean ; { See if Dos can be called }
Begin {DosCallsAllowed}
DosCallsAllowed := false ; { assume Dos is busy }
{ -- CHECK TO SEE IF SOFT INTS BUSY -- }
If INTS_Busy <> 0 then Exit ; { Critcal interrupts busy }
{ -- CHECK TO SEE IF A PRINT SCREEN IS IN PROGRESS -- }
{ byte is at 50:00 1=active ff=last attempt bad }
if PrintScreenStatus = 1 then Exit ;
{ -- CHECK TO SEE IF DOS IS BUSY -- }
If (byte(InDosStatus^)) or (byte(DosCriticalStatus^)) = 0 then {ok}
else begin
If (byte(InDosStatus^)) > 1 then exit ;
If byte(DosCriticalStatus^) <> 0 then exit ;
If NOT (DosIdle ) then Exit ;
end{else..} ;
port[ $20] := $0B ; { CHECK THE 8259A PIC ISR REGISTER }
punt ; { FOR NON-EOI'd pending Intr's }
if port[$20] <> 0 { tell 8259A we want the ISR }
then exit ; { get the pending intr bits }
DosCallsAllowed := true ; { -- ALL IS CLEAR, DO SOMETHING -- }
End {DosCallsAllowed} ;
{─────────────────────────────────────────────────────────────────────}
{ SAVE ENVIRONMENT }
{─────────────────────────────────────────────────────────────────────}
{ Save the Current procedure state in a StayResidentBlock }
{─────────────────────────────────────────────────────────────────────}
Procedure Save_Environment(var SRBlock: SRBptr) ;
VAR
regs : registers ; { local set of registers }
BEGIN { Record the stack limits }
WITH SRBlock^,regs DO BEGIN
GetIntVec(DOSI22, INT22ptr); { save task terminate vector }
GetIntVec(DOSI23, INT23ptr); { save ctrl break vector }
GetIntVec(DOSI24, INT24ptr); { save critical error vector }
GetIntVec(DOSI1B, INT1Bptr); { save DOS ctrl break vector }
GetDTA(DTA ) ; { save disk transfer addr }
GetPSP(PSP ) ; { save Prefix storage addr }
{ Save extended error information }
Ax := $5900 ;
Bx := 0 ;
If DosVersion > 2 then
Intr($21,regs) ;
ExtErrInfo[1] := Ax ;
ExtErrInfo[2] := Bx ;
ExtErrInfo[3] := Cx ;
ExtErrInfo[4] := Dx ;
ExtErrInfo[5] := Si ;
ExtErrInfo[6] := Di ;
ExtErrInfo[7] := Ds ;
ExtErrInfo[8] := Es ;
{ Save Ctrl-C status }
Ax := $3300 ;
Intr($21,regs) ;
CtrlCstatus := Dl ;
{ Save Verify flag status }
Ax := $5400 ;
Intr($21,regs) ;
VerifyStatus := Al ;
if procid = resources[_kbd] then
if (resources[_crt] = 0)
or (resources[_crt] = procid) then
begin
SRBVideoPage := VideoPage ;
cursorX := whereX ;
cursorY := whereY ;
cursortype := BIOScursor ;
end ;
if resources[_kbd] = 1 then begin { if foreground task..}
cursorx := Videox ; { get DOS cursor posn }
cursory := Videoy ; { since unknow to the }
end {if procid..} { Turbo RTL }
END { with SRBlock } ;
END {Save_Environment} ;
{─────────────────────────────────────────────────────────────────────}
{ RESTORE ENVIRONMENT }
{─────────────────────────────────────────────────────────────────────}
{ Restore a StayResidentBlock to the Current task }
{─────────────────────────────────────────────────────────────────────}
Procedure Restore_Environment(var SRBlock: SRBptr) ;
VAR
regs : registers ; { local set of registers }
BEGIN
WITH SRBlock^,regs DO BEGIN
SetIntVec(DOSI22, INT22ptr); { replace task terminate vector }
SetIntVec(DOSI23, INT23ptr); { replace ctrl break vector }
SetIntVec(DOSI24, INT24ptr); { replace critical error vector }
SetIntVec(DOSI1B, INT1Bptr); { replace DOS ctrl break vector }
SetDTA(DTA) ; { new disk transfer area }
SetPSP(PSP) ; { new Prefix storage area }
{ Restore extended error information }
Ax := $5D0A ;
DS := Seg(ExtErrInfo) ;
Dx := ofs(ExtErrInfo) ;
If DosVersion > 2 then
Intr($21,regs) ;
{ Restore Ctrl-C status }
Ax := $3301 ;
Dl := CtrlCstatus ;
Intr($21,regs) ;
{ Restore Verify flag status }
Ax := $5400 ;
Al := VerifyStatus ;
Intr($21,regs) ;
if procid = resources[_kbd] then { if keyboard owned put }
begin
gotoXY(cursorX,cursorY) ; { cursor in window }
ah := 1 ; { Turn cursor back on }
cx := Cursortype ;
intr($10,regs) ;
end
else begin
gotoxy(VideoCols+1,Videorows) ; { hide the cursor }
ah := 1 ; { turn cursor off }
ch := $20 ;
intr($10,regs) ;
end {else} ;
if resources[_kbd] = 1 then begin
Ah := 02 ; { Replace forgound cursor }
Bh := SRBVideoPage ;
Dl := cursorX ;
Dh := cursorY ;
Intr($10,regs) ;
end {if procid..} ;
END { with SRBlock } ;
END {Restore_Environment} ;
{─────────────────────────────────────────────────────────────────────}
{ SwitchEnvironment (dispatcher) }
{─────────────────────────────────────────────────────────────────────}
{ switch the environment to a new task }
{─────────────────────────────────────────────────────────────────────}
Procedure SwitchEnvironment ;
var
i : integer ;
found : boolean ;
TestingSRB : SRBptr ;
BEGIN
If RUTidBlk.RUTtermbyte then { when outside pgm has set }
begin { the termination byte... }
SingleTask; { SingleTask the system }
SR50_xit ; { Attempt to terminate }
MultiTask ; { MultiTask and Try later ..}
end {if RUT..} ;
If DosCallsAllowed then begin
Save_Environment(CurrentSRB) ; { save current tasks environment }
Found := false ;
i := 0 ;
TestingSRB := CurrentSRB^.SRBlink ;
repeat {until (i=NumactiveSRBs or found=true}
{ If a Timer task is within a resonable period of its tick }
{ request, make it eligible for dispatch, turn off wait bit }
With TestingSRB^ do
if SRBtype = Timertype then
if (TimerTicks mod Keyvalue) < NumActiveSRBs then
SRBSuspended := SRBSuspended and (NOT TimerWait)
else SRBsuspended := SRBsuspended or TimerWait ;
if TestingSRB^.SRBSuspended = 0 { get next ready task }
then begin
CurrentSRB := TestingSRB ; { Yield to the Next ready task }
Found := true ;
end {if TestingSRB..}
else begin { else look for a ready task }
inc(i) ;
TestingSRB := TestingSRB^.SRBlink ;
end {else..} ;
until (i=NumActiveSRBs) or (found=true) ;
Restore_Environment(CurrentSRB) ; { setup the new environment }
end {if DosCallsAllowed} ;
if Found then begin
inc(RotrPosition) ; { show the dispatch }
byte(PutRotr^ ) := { at upright corner }
Rotreller[RotrPosition mod 4] ; { turn the rotor }
end {if Found..} ;
END {SwitchEnvironment} ;
{────────────────────────────────────────────────────────────────────}
{ Yield }
{────────────────────────────────────────────────────────────────────}
{ Yield the CPU to some other procedure }
{────────────────────────────────────────────────────────────────────}
Procedure Yield ;
BEGIN
If bool(Status and frozen) { if system is frozen then }
then exit ; { return to same task }
Status := status or inuse ; { stop other interference }
SaveStackFrame ; { Make like an interrupt }
CurrentSRB^.SRBStackptr { record current stackframe }
:= ptr(SSeg,getbp) ;
SwitchEnvironment ; { switch to new task environment }
DisableInterrupts ; { stop other interference }
Status := status and { clear inuse status bit }
(not inuse) ;
ReturntoNewTask ; { switch to new stack frame }
RestoreStackFrame ; { Restore regs like an interrupt }
{ and IRET to next task }
END {Yield} ;
{────────────────────────────────────────────────────────────────────}
{ Resource Reserve/Rlse }
{────────────────────────────────────────────────────────────────────}
{ Reserve/Release a resource defined in Resource array }
{────────────────────────────────────────────────────────────────────}
Procedure Resource(operation, resourceid : integer ) ;
BEGIN
case operation of
Reserve :
Repeat
while resources[resourceid] <>0 do yield ;
resources[resourceid] := CurrentSRB^.procid ;
if resources[resourceid] = CurrentSRB^.procid
then exit ;
Until false ;
Rlse : if resources[resourceid] = CurrentSRB^.procid
then resources[resourceid] := 0 ;
end {case operation} ;
END {Resource} ;
{──────────────────────────────────────────────────────────}
{ CallInt16 }
{──────────────────────────────────────────────────────────}
{ Call the original Interrupt 16 vector }
{──────────────────────────────────────────────────────────}
const
ReadChar = $0000 ;
TestChar = $0100 ;
Procedure CallInt16( func :word; var AX,flags :word ) ;
Begin
inline(
$8B/$46/<func/ { MOV AX,func read kbd func }
$9C/ { PUSHF create an IRET return }
$FF/$1E/>BIOS_INT16/ { CALL FAR [old_INT16] }
{ Return the INT16 result registers, not the input regs }
$9C/ { PUSHF Save INT16 conditions }
$36/$c4/$7e/<flags/ { les di,ss:[^flags] return flags }
$26/$8F/$05/ { pop es:[di] }
$36/$c4/$7e/<AX/ { les di,ss:[^AX] return ax }
$26/$89/$05 ); { mov ax,es:[di] }
if func = testchar then { if function is "test keyboard" }
if boolean(flags and zflag) { then return .. }
then AX := $0000 ; { nul if no key, else return key }
end {CallInt16} ;
{──────────────────────────────────────────────────────────}
{ KeyWaiting }
{──────────────────────────────────────────────────────────}
{ Check if any keys waiting to be read in keyboard buffer }
{──────────────────────────────────────────────────────────}
Function KeyWaiting :boolean ;
var
int16flags : word ;
begin
inline(
$B4/01/ { MOV AH,testfunc 01 }
$9C/ { PUSHF create an IRET return }
$FF/$1E/>BIOS_INT16/ { CALL FAR [old_INT16] }
$9C/ { PUSHF Save INT16 conditions }
$8F/$46/<int16flags { pop [BP+int16flags] }
) ;
keywaiting := NOT boolean(int16flags and zflag) ;
end {KeyWaiting} ;
{────────────────────────────────────────────────────────────────────}
{ Check for Hot Key }
{────────────────────────────────────────────────────────────────────}
{ Scan all SRBs for a matching HotKey. If found, toggle the SRB }
{ suspended bit, and indicate last key was a hot one. }
{────────────────────────────────────────────────────────────────────}
Procedure CheckforHotKey(LastKeyStroke : word ) ;
var
i : integer ;
TestingSRB : SRBptr ;
OldKbdOwner : word ;
BEGIN
Hotkeyon := false ; { Turn off HotKey flag }
If LastKeyStroke = 0 then exit ; { exit on null input }
OldKbdOwner := Resources[_KBD] ;
TestingSRB := CurrentSRB ;
for i := 1 to NumactiveSRBs do
With TestingSRB^ do begin
if SRBType = Keytype then
if Keyvalue = LastKeyStroke then begin { Check SRB Hotkey for match }
Ints_busy := Int16on ; { stop dispatching }
Send('Popsched',TestingSRB) ; { Schedule this popup }
Hotkeyon := true ; { say last key was hotkey }
Ints_busy := Ints_busy and (NOT Int16on) ; { start dispatching }
EXIT ; { we have a task }
end {if keyvalue..} ;
TestingSRB := TestingSRB^.SRBlink ; { test next SRB }
end {for i..} ;
end {Check for Hot Key } ;
{──────────────────────────────────────────────────────────────────────}
{ Interrupt 16 ISR (Keyboard) }
{──────────────────────────────────────────────────────────────────────}
{ A flag is set when a hotkey occurs. All other keys pass on }
{──────────────────────────────────────────────────────────────────────}
Procedure Kbd_INT16(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
interrupt ;
Label
INT16exit ;
const
varbytes = 4 ; { number of bytes on local stack }
var
keyfunc :word ;
tempword :word ;
Begin
if CurrentSRB^.Procid = 1 then begin { special stack for foreground }
Inline(
$C4/$3E/>Int16stack { les di,[>INT16stack] ; address of current process block}
{ ;}
/$8C/$D2 { mov dx,ss ; save previous stack seg}
/$8C/$C0 { mov ax,es ; bp contains essential sp}
/$39/$D0 { cmp ax,dx ; if segments are the same}
/$75/$02 { jne L1 ; define sp previous to}
/$89/$E7 { mov di,sp ; current sp.}
/$06 {L1: push es ;}
/$17 { pop ss ; set local stack}
/$89/$FC { mov sp,di ;}
{ ; intr stack is 24 bytes}
/$B9/$18/$00 { mov cx,24 ; allow room for double stacking}
/$29/$CC { sub sp,cx ; eg, when this stack calls INT16}
{ ;}
/$52 { push dx ; save old sp}
/$55 { push bp ;}
/$29/$CC { sub sp,cx ; backup another 12 words}
/$8C/$DB { mov bx,ds ; save data segment address}
/$8E/$DA { mov ds,dx ; dseg gets old stack ss}
/$89/$EE { mov si,bp ; source ptr to old stack (ES contains old ss)}
{ ;}
/$16 { push ss ; dest pointer to new stack}
/$07 { pop es ;}
/$89/$E7 { mov di,sp ;}
{ ;}
/$D1/$E9 { shr cx,1 ; words to save (24/2 words)}
/$FC { cld ;}
/$F2/$A5 { rep movsw ; move old stack to new}
{ ;}
/$89/$E5 { mov bp,sp ; setup new bp}
/$81/$EC/>VARBYTES { sub sp,>varbytes ; room for local variables on stack}
/$8E/$DB { mov ds,bx ; recover dseg}
);
end {if..} ;
EnableInterrupts ;
{─────────────────────────────────────────────────────}
{ Read/Test a Key (function 00 and 01) }
{─────────────────────────────────────────────────────}
Keyfunc := AX and $FF00 ; { clear low byte }
flags := flags or zflag ; { assume no key available }
if keyfunc = ReadChar then begin
while Resources[_KBD] <> { suspend any task doing read..}
CurrentSRB^.Procid do { but not owning keyboard }
CurrentSRB^.SRBsuspended :=
CurrentSRB^.SRBsuspended or suspended ;
repeat {until KbdOwned and GoodKey}
while NOT keywaiting do {loop} ; { wait for available key }
CallInt16(testchar,AX,flags) ; { test the key value }
CheckforHotKey(AX) ; { see if one of our keys }
if HotKeyon then
CallInt16(readchar,AX,flags) ; { eat the hotkey }
until
(Resources[_KBD] = CurrentSRB^.Procid) { keys to kbd owner only }
and (NOT HotKeyon ) ;
CallInt16(readchar,AX,flags) ; { finally, get the key }
GOTO INT16exit ;
end { if hi(.. } ;
{─────────────────────────────────────────────────────}
{ TEST for a Key (function 01) }
{─────────────────────────────────────────────────────}
if keyfunc = TestChar then begin { check for char (func01) }
if Resources[_KBD] <> CurrentSRB^.Procid
then GOTO int16exit ;
if keywaiting then begin
CallInt16(testchar,AX,flags) ; { Sneak look at next key }
CheckforHotKey(AX) ; { see if one of our hotkeys }
if Hotkeyon then begin
CallInt16(readchar,AX,flags) ; { eat the hotkey }
AX := 0 ; { set up for empty return }
flags := flags or zflag ; { set zflag if hotkey }
HotKeyon := false ; { Turn off the hotkey status}
end {if hotkeyon..} ;
end {if keywaiting} ;
GOTO int16exit ; { exit ISR }
end {if hi..} ;
{───────────────────────────────────────────────────────────────────}
{ Are You There }
{───────────────────────────────────────────────────────────────────}
{ Es:di contains a pointer to the asking user id blk. Compare the }
{ string to our id block. If same, switch ax:bx and replace }
{ es:di with pointer to our id block. Else continue down the INT 16 }
{ chain. }
{───────────────────────────────────────────────────────────────────}
if AX = $6c66 then begin { someone asking if we're here }
if RUTidblk.RUTidstr = string(ptr(es,di)^) then begin
ax := ax xor bx ; { swapping ax and bx says yes }
bx := bx xor ax ;
ax := ax xor bx ;
es := seg(RUTidblk) ; { show em our id block }
di := ofs(RUTidblk) ;
end {if RUTidblk} ;
GOTO int16exit ;
end {if keyfunc};
{ NOT one of our functions..pass to original INT 16 }
CallInt16(AX,AX,flags) ; { get the key }
INT16EXIT: { GOTO here from above functions read/test character }
if currentSRB^.procid = 1 then begin { special stack for foreground }
DisableInterrupts ;
Inline( { ; restore local to old stack}
$C4/$7E/$18 { les di,[bp+24] ; dest = old stack ptr}
/$89/$F8 { mov ax,di ; save old sp value}
/$89/$EE { mov si,bp ; point to local stack}
/$8C/$D2 { mov dx,ss ;}
/$8E/$DA { mov ds,dx ; source = local stack}
/$B9/$0C/$00 { mov cx,12 ; words to move}
/$FC { cld ;}
/$F2/$A5 { rep movsw ; move the stack}
/$8C/$C2 { mov dx,es ; switch to old stack}
/$8E/$D2 { mov ss,dx ;}
/$89/$C4 { mov sp,ax ; old sp ptr}
/$89/$E5 { mov bp,sp ; reset bp for return}
) ;
end {if current..} ;
end; {SR50i16}
{────────────────────────────────────────────────────────────────────}
{ DISK I N T _ 1 3 }
{────────────────────────────────────────────────────────────────────}
{ Set a status bit when I/O is outstanding to disk }
{────────────────────────────────────────────────────────────────────}
{$S-}
Procedure DISK_INT13(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
interrupt ;
BEGIN {Disk_Int13}
inline(
$80/$0E/>INTS_Busy/INT13on / { OR INTS_Busy,Int13flag }
$8B/$86/AX/ { MOV AX,[BP+AX] retrieve parm }
$9C/ { PUSHF create an IRET return }
$FF/$1E/>BIOS_INT13/ { CALL FAR [oldDiskInt13] }
$9C/ { PUSHF Save INT13 condition }
$FA/ { disable interrupts }
$8F/$86/flags/ { Pop [bp+flags] return flags also}
$80/$26/>INTS_Busy/255-INT13on { AND INTS_Busy,Int13flag }
);
{ Return the INT13 result registers, not the input regs }
inline(
$8E/$5E/<DS/ { MOV DS,[BP+DS] }
$89/$86/AX/ { MOV [BP+AX],AX }
$8B/$86/BP/ { MOV AX,[BP+BP] }
$89/$86/BX/ { MOV [BP+BX],AX }
$8D/$AE/BX/ { LEA BP,[BP+BX] }
$89/$EC/ { MOV SP,BP }
$5D/ { POP BP }
$58/ { POP AX }
$CF ); { IRET }
END {DISK_INT13} ;
{$S+}
{────────────────────────────────────────────────────────────────────}
{ T I M E R Interrupt 8 service routine }
{────────────────────────────────────────────────────────────────────}
{ ─────────────────── T I M E R _ I S R ────────────────────── }
{────────────────────────────────────────────────────────────────────}
{$S-}
Procedure TIMER_ISR(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word) ;
interrupt ;
Begin {Timer_ISR}
{$R-,S-}
inc(TimerTicks,1) ;
if int8busy then
JumpToInterrupt(BIOS_INT8) ;
inc(int8busy) ; { Tell 'em we're busy now }
InTimerStackptr { protect user stackframe }
:= ptr(SSeg,ofs(BP)) ; { from further interrupts }
Switch_to_Timer_Stack ; { switch to internal stack }
{$R+,S+}
Push(vec(InTimerStackptr).seg) ; { Preserve Incoming stack ptr }
Push(vec(InTimerStackptr).ofs) ; { in case of new interrupt }
CallInterrupt(BIOS_INT8) ;
EnableInterrupts ; { allow interrupts }
if bool(Status and inuse) { skip if TSR in use already }
then Exit_Timer ;
if bool(Status and frozen) { skip if TSR in halted }
then Exit_Timer ;
if DosCallsAllowed then {ok} { See if dos is idle }
Int8waiting := 0 { say dispatch successful }
else begin
inc(Int8waiting) ; { say INT8 missed a dispatch }
Exit_Timer ; { skip if DOS too busy now }
end ;
pop(vec(CurrentSRB^.SRBstackptr).ofs) ; { CurrentSRB^.SRBstackptr := }
pop(vec(CurrentSRB^.SRBstackptr).seg) ; { InTimerStackptr ; }
SwitchEnvironment ; { Yield to next task }
DisableInterrupts ; { Protect stack change }
int8busy := false ; { clear busy condition }
ReturnToNewTask ; { Load new Stack Frame .. }
{ and return to another task }
End;{SR50_Int8}
{──────────────────────────────────────────────────────────────────────}
{ Interrupt 28 ISR (Dos Idle) }
{──────────────────────────────────────────────────────────────────────}
{ Entry is made from the DOS interrupt 28 during a read idle loop }
{──────────────────────────────────────────────────────────────────────}
{$S-}
Procedure DOS_IDLE(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
interrupt ;
BEGIN {DOS_Idle }
if INT8waiting = 0 then begin { If INT8 not waiting then }
CallInterrupt(Dos_Int28) ; { dont waste time here }
exit ;
end {if INT8wait..} ;
if DosIdleCount > 0 then exit ; { avoid double entries }
If byte(InDosStatus^) > 1 { Dont interrupt Dos internals }
then exit ;
If byte(DosCriticalStatus^) <> 0
then exit ;
If INTS_Busy <> 0 then exit ; { Exit if interrupts busy }
If int8busy then exit ; { if timer active then exit }
CallInterrupt(Dos_Int28) ; { call old interrupt 28 }
{*If byte(InDosStatus^) = 0 { skip int28 calls from user }
{* then exit ; { ..pgms issuing INT28 }
inc( DosIdleCount) ; { show overhead count }
DisableInterrupts ; { stack is being manipulated }
inline( { switch to safe stack }
$16/ { Push SS }
$55/ { Push BP }
$C4/$1E/DosIdleSRB/ { LES BX,[DosIdleSRB] }
$26/$C4/$5F/$00/ { LES BX,ES:[BX+stackptr]}
$26/$8F/$47/$FC/ { pop ES:[bx-4] save Sp }
$26/$8F/$47/$FE/ { pop ES:[bx-2] save SS }
$83/$EB/$04/ { Sub bx,4 backup sp }
$8C/$C0/ { MOV AX,ES }
$8E/$D0/ { MOV SS,AX }
$89/$DC/ { MOV SP,BX }
$89/$E5 ); { MOV BP,SP }
{$S+}
{ Make room on IdleStack }
SetSp(GetBP-64-2) ; { back up the stack ptr }
DosStackptr := ptr(vec(InDosStackptr).seg, { backup 32 words }
vec(InDosStackptr).ofs-64 ) ; { on indos stack }
{ save InDos Stackframe }
Move(DosStackptr^,ptr(SSeg,GetBP-64)^,64) ;
DosIdle := true ; { tell everybody DOS is idle }
{ Timer may now preempt this task until DosIdle = false }
EnableInterrupts ;
Delay(DosIdledelay) ;
DosIdle := false ; { say we are nolonger idle }
{ restore the DOS stack frame }
DisableInterrupts ;
Move(ptr(SSeg,GetBP-64)^,DosStackptr^,64) ;
SetSp(GetBP) ; { restore the stackptr from BP }
inline( { switch back to dos stack }
$89/$E5/ { MOV BP,SP point to SS:SP}
$C4/$5E/$00/ { LES BX,[BP+00] fetch SS:SP }
$8C/$C0/ { MOV AX,ES temp move }
$8E/$D0/ { MOV SS,AX set old stack }
$89/$DC/ { MOV SP,BX set old sptr }
$89/$E5 ); { MOV BP,SP set BP }
dec(DosIdlecount);
END {DOS IDLE } ;
{$S+}
{────────────────────────────────────────────────────────────────────}
{ Setup ISRs }
{────────────────────────────────────────────────────────────────────}
Procedure Setup_ISRs ; { Setup Interrupt Service Routines }
begin
DisableInterrupts ;
GetIntVec(BIOSI16, Bios_Int16) ;
GetIntVec(BIOSI8 , BIOS_Int8 ) ;
GetIntVec(BIOSI13, BIOS_Int13) ;
GetIntVec(DOSI28 , DOS_Int28 ) ;
SetIntVec(BIOSI16, @Kbd_INT16 ) ; { keyboard }
SetIntVec(BIOSI8 , @Timer_ISR ) ; { timer }
SetIntVec(BIOSI13, @Disk_INT13 ) ; { disk }
SetIntVec(DOSI28 , @DOS_Idle ) ; { DOS idle }
EnableInterrupts ;
end {Setup_ISRs} ;
{────────────────────────────────────────────────────────────────────────────}
{ S T A Y X I T }
{────────────────────────────────────────────────────────────────────────────}
{ SR50_Xit Check Terminate Keys }
{ }
{ Clean up the Program ,Free the Environment block, the program segment }
{ memory and return to Dos. Programs using this routine ,must be the }
{ last program in memory, else ,a hole will be left causing Dos }
{ to take off for Peoria. }
{────────────────────────────────────────────────────────────────────────────}
{ This procedure should be executed when user enters "SR50 /quit" .. }
{────────────────────────────────────────────────────────────────────────────}
Procedure SR50_Xit;
TYPE
MCB = record
mcbtype : char ; {M or Z identifier }
mcbseg : integer ; {Segment of Program Prefix}
mcblength : integer ; {Length in paragraphs }
END ;
const
PSPvector22 = $0A ; { PSP offset to terminate vector }
PSPvector23 = $0E ; { PSP offset to ctrl break vector }
PSPvector24 = $12 ; { PSP offset to critical exit vector }
VAR
MemBlkPtr :^MCB ;
DOSvector22: vector absolute 0:$88 ;
DOSvector23: vector absolute 0:$8C ;
DOSvector24: vector absolute 0:$90 ;
Regs : registers ;
Begin { Block }
{ See if next Memory block pointer is the last MCB }
MemBlkPtr := ptr(Prefixseg-1,0000 ) ; { our MCB }
MemBlkPtr := ptr(MemBlkptr^.MCBseg + MemBlkptr^.MCBlength,0) ;
{ next MCB }
If MemBlkPtr^.mcbtype <> 'Z' then
begin
Writeln ( ' Not last program in memory. Cannot uninstall.');
EXIT ; {not last, cant end}
end;
ClrEol ; Writeln ( RUTidBlk.RUTidStr,' terminated on request') ;
DisableInterrupts ;
SetIntVec(BIOSI13, BIOS_Int13) ; { Restore Disk Interrupt Service Rtn }
SetIntVec(BIOSI16, Bios_Int16) ; { Restore Keyboard Interrupt Service }
SetIntVec(BIOSI8 , BIOS_Int8 ) ; { Restore Timer Interrupt Service }
SetIntVec(DOSI28 , DOS_Int28 ) ; { Restore DOS 28 Interrupt Service }
{ Move Interrupt Vectors 22,23,24 to our PSP from where DOS will restore }
meml[Prefixseg:PSPvector22] := longint(DOSvector22); { Terminate vector }
meml[Prefixseg:PSPvector23] := longint(DOSvector23); { Cntrl-C vector }
meml[Prefixseg:PSPvector24] := longint(DOSvector24); { Critical vector }
EnableInterrupts ; { Re-enable interrupts }
Regs.Ax := $4900 ; { Free Allocated Block function }
Regs.Es := MemW[Prefixseg:$2C] ; { Free environment block }
intr($21, Regs) ;
Regs.Ax := $4900 ; { Free Allocated Block function }
Regs.Es := Prefixseg ; { Free Program }
intr($21, Regs) ;
regs.Ax := $4C00 ; { say bye bye, baby blue .. }
intr($21, Regs) ;
End { SR50Xit };
{──────────────────────────────────────────────────────────────────────}
{ Dummy IRET }
{──────────────────────────────────────────────────────────────────────}
Procedure DummyIret ;
begin
inline($5D/$C9) ; { pop bp, iret }
end {DummyIret} ;
{──────────────────────────────────────────────────────────────────────}
{ Start TSR }
{──────────────────────────────────────────────────────────────────────}
Procedure StartTSR ;
const
esc = #27 ;
var
ch : char ;
Begin {StartTSR}
if debug then begin
Writeln(' - Debugging Information -' ) ;
Writeln('CurrentSRB : ',hexptr(@CurrentSRB )) ;
Writeln('InTimerStackptr: ',hexptr(@InTimerStackptr)) ;
Writeln('Status : ',hexptr(@Status )) ;
Writeln('Ints_Busy : ',hexptr(@Ints_Busy )) ;
Writeln('Int8Busy : ',hexptr(@Int8Busy )) ;
Writeln('DosIdle : ',hexptr(@DosIdle )) ;
Writeln('DosIdleCount : ',hexptr(@DosIdleCount )) ;
Writeln('InDosStatus : ',hexptr(InDosStatus )) ;
Writeln('InDosStackptr : ',hexptr(InDosStackptr )) ;
Writeln('@WindMax : ',hexptr(@WindMax )) ;
end {if debug..} ;
SwapVectors ;
Status := status and
( NOT inuse ) ; { allow dispatching }
if debug then begin { debug loop to allow running }
While ch <> esc do { under a foreground debugger }
ch := readkey ; { drive int 16 like dos }
Exit ; { return to dos when debug on }
end {if debug..} ;
Keep(0) ; { Go into TSR mode }
end {StartTSR} ;
{──────────────────────────────────────────────────────────────────────}
{ Attach }
{──────────────────────────────────────────────────────────────────────}
{ Attach is called form the initialization routine and must be }
{ forced as a far call procedure }
{──────────────────────────────────────────────────────────────────────}
{$F+}
Procedure Attach( pUserPgmPtr:pointer; TsrType:word;
TsrValue:word ; pPopproc:pointer ; pName:string8) ;
VAR {$F-}
tSRBptr : SRBptr ;
StatusAreaSize : integer ;
i : integer ;
Begin {Attach}
StatusAreaSize := StackSize + { size of SRBlock + pgm stack }
StackOverhead ;
Getmem(tSRBptr,StatusAreaSize) ; { fetch space for SRB and Stack }
If CurrentSRB = nil then
CurrentSRB := tSRBptr ; { anchor the first SRB ptr }
inc(NumActiveSRBs) ; { add to active task count }
With tSRBptr^ do begin { initialize the TaskStatusBlk }
Fillchar(tSRBptr^,
sizeof(SRBlock),0) ; { Clear garbage }
procptr := pUserPgmPtr ; { addr of task to execute }
SRBtype := TsrType ; { Timer or hotkey type }
Keyvalue := TsrValue ; { ticks or Key code }
Popproc := pPopproc ; { Popup/dn maintenance routine }
SRBName := pName ;
SRBstackptr := ptr(seg(tSRBptr^), { point to stackframe top }
ofs(tSRBptr^) + StatusAreaSize { actually, bottom of the SRB }
- sizeof(stackframe)-1 ) ; { minus size of a stackframe }
SRBstackptr^.DS := dseg ; { init Dseg for later restore }
SRBstackptr^.BP := getbp ; { get reasonable value for bp }
procid := NumActiveSRBs ;
SRBstackptr^.IP := ofs(procptr^) ; { make an IRET frame on the new }
SRBstackptr^.CS := seg(procptr^) ; { ..stack to invoke user proc }
Pushflags ; { push ordinary flags on stack }
pop(SRBstackptr^.flags) ; { stow 'em on stack frame }
Save_Environment(tSRBptr) ; { init thread environment }
CursorX := 1 ;
CursorY := 1 ;
Cursortype := BIOScursor ; { save cursor scan lines }
SRBSuspended := Suspended ; { make SRB suspended }
If TsrType = TimerType then
SRBSuspended := TimerWait ;
if TsrType = Systype then { unsuspend sys tasks }
SRBSuspended := 0 ;
SRBlink := CurrentSRB^.SRBlink ; { duplicate the link SRB }
CurrentSRB^.SRBlink := tSRBptr ; { current SRB gets ptr to new }
END {with tSRBptr}
end {Attach} ;
{──────────────────────────────────────────────────────────────────}
{ Critical Error EXIT }
{──────────────────────────────────────────────────────────────────}
{ Restore system vectors, tattle on whomever and exit }
{──────────────────────────────────────────────────────────────────}
{$F+}{$S-} PROCEDURE Critical_Exit; {$F-}
BEGIN
ExitProc := Exit_Vec ; {restore previous ExitProc}
DisableInterrupts ;
SetIntVec(BIOSI13, BIOS_Int13) ; { Restore Disk Interrupt Service Rtn }
SetIntVec(BIOSI16, Bios_Int16) ; { Restore Keyboard Interrupt Service }
SetIntVec(BIOSI8 , BIOS_Int8 ) ; { Restore Timer Interrupt Service }
SetIntVec(DOSI28 , DOS_Int28 ) ; { Restore DOS 28 Interrupt Service }
EnableInterrupts ;
writeln('CurrentTask: ',CurrentSRB^.SRBname,' #',CurrentSRB^.procid) ;
END {Critical_Exit} ;
{$S+}
{──────────────────────────────────────────────────────────────────────}
{ POPSCHED }
{──────────────────────────────────────────────────────────────────────}
{ Schedules POPup POPdn routines and enables the popup tasks }
{──────────────────────────────────────────────────────────────────────}
{$F+} Procedure POPsched ; {$F-}
var
OldSRBptr : SRBptr ;
NewSRBptr : SRBptr ;
PopParm : boolean ;
Begin REPEAT {forever}
Receive('popsched', { receive srbptr to schedule }
pointer(NewSRBptr)) ; { and wait when none ready }
OldSRBptr := FindSRB(Resources[_KBD]) ; { Suspend current popup routine }
if OldSRBptr^.keyvalue <> 0 then { only if its a Keytype task }
Suspend(OldSRBptr^.procid,
Suspended ) ;
PopParm := false ; { say this is a popdown }
if OldSRBptr^.PopProc <> nil then begin
push(word(PopParm)) ;
Callfar(OldSRBptr^.POPproc) ; { call its PopUp/Dn routine }
end ;
if OldSRBptr^.procid = { Dont re-popup a task using }
NewSRBptr^.procid then { a toggle up/dn hotkey }
begin
Resources[_KBD] := 1 ; { Dos gets the keyboard }
UnSuspend(1,suspended) ; { Activate the forground task }
end
else
With NewSRBptr^ do begin { but call new task popup proc }
PopParm :=
boolean(SRBsuspended AND $0001 ) ; { if suspended then popup time}
if PopProc <> nil then begin { if false, then popdown time }
push(word(PopParm)) ;
Callfar(POPproc) ;
end ;
if PopParm then begin
Resources[_KBD] := procid ; { if popup assign keyboard }
Unsuspend(procid,suspended) ; { and set SRB unsuspended }
end {if PopParm}
else {popdn} begin { if popdouwn.. }
Resources[_KBD] := 1 ; { Dos gets the keyboard }
Suspend(procid,suspended) ; { and task is suspended }
end {else..} ;
end {else with PopSRBptr..} ;
UNTIL false ; End {Popsched} ;
{──────────────────────────────────────────────────────────────────────}
{ initialization }
{──────────────────────────────────────────────────────────────────────}
var
regs : registers ;
begin {initialization}
Status := status or inuse ; { disallow dispatching }
PutRotr := ptr($B800,0) ; { Show a Rotor in }
If lo(lastmode) = mono then { upper right of screen }
PutRotr := ptr($B000,0) ; { for each dispatch of }
Videoseg := vec(PutRotr).seg ; { yield request }
incptr(PutRotr, 80*2-2) ;
{ issure int 16 "are you there" request to a (possibly) }
{ previously loaded SR50. BX will be loaded wih AX if already }
{ resident. If Paramstr is "quit", zap the previously loaded }
{ SR50 termination byte. }
Getmem(Int16stack,stacksize) ;{ Forground INT16 functions stack }
incptr(Int16stack,stacksize) ;
inline($CC);
With Regs DO BEGIN { See if already resident }
ax := $6C66 ; { our "see quit" keyboard function }
bx := $0000 ; { ax and bx will switch if TSR }
es := dseg ; { point ES:DI to our RUT id block }
di := ofs(RUTidblk) ; { Are You There id block }
intr($16,regs) ; { issue keyboard read }
If bx = $6c66 then begin { resident if bx ax switch}
if paramstr(1) = 'quit' then
with RUTidblktype(ptr(es,di)^) do
RUTtermbyte := true { set terminate byte if resident }
else { Already resident.. exit }
writeln(^G,'SR 5.0 is already resident.') ;
HALT(0) ;
end {if bx} ;
END {with regs} ;
NumActiveSRBs := 0 ; { assume no active tasks }
CurrentSRB := nil ; { show no SRB chain yet }
GetMem( DosIdleSRB,
sizeof(SRBlock)+stacksize ) ; { memory for SRB and stack }
With DosIdleSRB^ do begin { used to hold InDos stack }
SRBStackptr := stackptr(DosIdleSRB) ; { initialize SRB stack ptr }
incptr(SRBStackptr,
sizeof(SRBlock)+stacksize-2) ; { point stack @ SRB bottom }
end {with..begin} ;
GetMem( TimerSRB,
sizeof(SRBlock)+stacksize ) ; { memory for SRB and stack }
With TimerSRB^ do begin { used to hold InDos stack }
SRBStackptr := stackptr(TimerSRB) ; { initialize SRB stack ptr }
incptr(SRBStackptr,
sizeof(SRBlock)+stacksize-2) ; { point stack @ SRB bottom }
end {with..begin} ;
DftWindow[3] := VideoCols ; { attempt to assign the bios }
DftWindow[4] := VideoRows ; { screen coordinates. If nil }
if VideoCols = 0 then { assign the usual 80 by 25 }
DftWindow[3] := 80 ;
if videoRows = 0 then
DftWindow[4] := 25 ;
{ create a Dwell task, one which is always dispatchable }
Attach(@DummyIret,KeyType, { Add Dos as a task }
0000,NIL,'DOS') ; { with an impossible keycode }
{ CurrentSRB now has ptr }
NumActiveSRBs := 1 ; { reset to one active task }
With CurrentSRB^ do BEGIN { fix up the first SRB }
SRBlink := CurrentSRB ; { first SRB points to itself }
SRBstackptr := ptr(Sseg,Sptr) ; { New thread stack pointer }
procid := 1 ; { Dos thread id }
popproc := nil ;
SRBname := 'FOREGRND' ;
SRBSuspended := 0 ; { Foreground never suspended }
END {with currentSRB} ;
Attach(@POPSched,Systype, { attach the pop up schedular }
0000,nil,'SCHED') ;
MakeMailBox('POPSCHED') ; { popupdn scheduler mail box }
Setup_ISRs ; { activate TSR vector traps }
Exit_Vec := ExitProc ; { Chain into ExitProc }
ExitProc := @Critical_Exit ; { install additional exit }
end {initialization} .
(**************************************************************************)